Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/DB_CLIPP/0292.ZIP/TRACKIT.ARC/TRACK_IT.PRG

Text File | 1985-12-21 | 5KB | 215 lines

* FILE NAME           TRACK_IT.PRG
* MAIN PROGRAM        TRACK_IT.PRG
* PROGRAMMER          DAVID IRWIN
* DATE WRITTEN        12/15/84
* LAST UPDATE         01/08/85
*
*
* This is the main driver for the TRACK-IT+ system and calls
* only trackpro.prg, its procedure file.
*
*
CLEAR
CLEAR ALL
SET EXCAPE OFF
SET TALK OFF
SET BELL OFF
SET PROCEDURE TO trackpro
USE trackrst INDEX trackrdx
SELECT 2
USE track_it INDEX tracknme, trackco, trackprd, tracknxt, tracksts
SET FUNCTION 2 TO "2;"
SET FUNCTION 3 TO "3;"
SET FUNCTION 4 TO "4;"
SET FUNCTION 5 TO "5;"
SET FUNCTION 6 TO "6;"
SET FUNCTION 7 TO "7;"
SET FUNCTION 8 TO "8;"
SET FUNCTION 9 TO "9;"
SET FUNCTION 10 TO "10"
PUBLIC action, choice, choice2, looper, tblanks, tseek
STORE " " TO action, choice, choice2, string
more = .T.
dstring = DATE()
* SET color to gr/b,w/r,

DO mainmenu

DO WHILE more
   looper = .F.
   action = " "
   DO CASE

      CASE choice = "2"
         tseek = "Last Name"
         tblanks = 15
         DO tstring
         SET INDEX TO tracknme, trackco, trackprd, tracknxt, tracksts
         DO if_blank

      CASE choice = "3"
         tseek = "Company Name"
         tblanks = 20
         DO tstring
         SET INDEX TO trackco, trackprd, tracknxt, tracksts, tracknme
         DO if_blank

      CASE choice = "4"
         tseek = "Product Name"
         tblanks = 20
         DO tstring
         SET INDEX TO trackprd, tracknxt, tracksts, trackco, tracknme
         DO if_blank

      CASE choice = "5"
         @ 10,30 SAY "Date to Find" GET dstring PICTURE "@D"
         READ
         IF dtoc(dstring) = " "
            looper = .T.
            dstring = DATE()
         ELSE
            SET INDEX TO tracknxt, tracksts, tracknme, trackco, trackprd
            SEEK dstring
            IF eof()
               string = dtoc(dstring)
               dstring = ctod( "        " )
            ENDIF eof()
         ENDIF dtoc(dstring) = " "

      CASE choice = "6"
         tseek = "Status"
         tblanks = 1
         DO tstring
         SET INDEX TO tracksts, tracknme, trackco, trackprd, tracknxt
         DO if_blank

      CASE choice = "7"
         SET INDEX TO tracknme, trackco, trackprd, tracknxt, tracksts
         SET FUNCTION 10 to dtoc(DATE())
         APPEND BLANK
         DO tscreen
         DO tgets
         SET FUNCTION 10 TO "10"
         looper = .T.

      CASE choice = "8"
         dot = .T.
         DO WHILE dot
            ACCEPT ". " TO string
            IF len(string)=0 .OR. string= ' '
               EXIT
            ELSE
               &string
               ?
            ENDIF len(string)=0 .OR. string= ' '
         ENDDO WHILE dot
         looper = .T.

      CASE choice = "9"
         PUBLIC choice2
         DO exitmenu
         DO CASE
            CASE choice2 = "1"
               more = .F.
               dos_exit = .F.
               LOOP
            CASE choice2 = "2"
               more = .F.
               dos_exit = .T.
               LOOP
         ENDCASE
         looper = .T.

      CASE choice = "10"
         tseek = "Last Name"
         tblanks = 15
         DO tstring
         SELECT 1
         GO TOP
         IF lname # " "
            APPEND BLANK
         ENDIF lname # " "
         SEEK upper(trim(string))
         IF eof()
            GO TOP
         ENDIF eof()
         BROWSE
         SELECT 2
         looper = .T.
   ENDCASE
   IF looper
      DO mainmenu
      LOOP
   ENDIF looper
   IF eof()
      * SET color TO r/w,w/r,
      @ 14,1
      center = 40 - int(len(trim(string)) + 26)/2
      @ 14,center SAY "No Records Found Matching " + trim(string)
      ?? chr(7)
      * SET color TO gr/b,w/r,
      LOOP
   ENDIF eof()
   SET FUNCTION 10 TO dtoc(DATE())
   error = .F.
   CLEAR
   DO tscreen
   DO WHILE action # "D"
      IF .not. error
         DO tsays
      ENDIF .not. error
      action = " "
      error = .F.
      DO contline

      DO CASE
         CASE action = "D"
            LOOP
         CASE action = "N"
            SKIP
            IF eof()
               @ 23,1
               @ 23,34 SAY "End of File !"
               ? chr(7)
               error = .T.
               SKIP -1
               LOOP
            ENDIF eof()
         CASE action = "P"
            SKIP -1
            IF bof()
               @ 23,1
               @ 23,29 SAY "First Record in File !"
               ? chr(7)
               error = .T.
               GO recno()
               LOOP
            ENDIF bof()
         CASE action = "E" .OR. action = "U"
            @ 23,1 CLEAR
            DO tgets
         CASE action = "M"
            SET FORMAT TO trackmem
            CHANGE next 1 FIELDS notes
            SET FORMAT TO
            SKIP -1
            CLEAR
            DO tscreen
         OTHERWISE
            ? chr(7)
            error = .T.
      ENDCASE
   ENDDO WHILE action # "D"
   SET FUNCTION 10 TO "10"
   CLEAR
   DO mainmenu

ENDDO
action = " "
IF dos_exit
   QUIT
ENDIF dos_exit
CLEAR
CLEAR ALL
RETURN